home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlEditing.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  35.5 KB  |  1,213 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlEngine.tcl"
  6.  #                                    created: 99-07-18 12.50.57 
  7.  #                                last update: 00-12-31 15.36.43 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains procs for the Editing submenu.
  35. #===============================================================================
  36.  
  37. #===============================================================================
  38. # ◊◊◊◊ Select container/in container ◊◊◊◊ #
  39. #===============================================================================
  40.  
  41. # select container, like Balance (cmd-B)
  42. proc html::SelectinContainer {} {html::SelectContainer 1}
  43.   
  44. proc html::SelectContainer {{inside 0}} {
  45.     set start [getPos]
  46.     if {[pos::compare $start != [minPos]] &&
  47.     ![catch {getText $start [pos::math $start + 2]} lookingAt] &&
  48.     $lookingAt != "</" &&
  49.     [string index $lookingAt 0] == "<"} {
  50.         set start [pos::math $start - 1]
  51.     }
  52.     set tags [html::GetContainer $start [selEnd]]
  53.     if {[llength $tags] == 5} {
  54.         if {$inside} {
  55.             select [lindex $tags 1] [lindex $tags 2]
  56.         } else {
  57.             select [lindex $tags 0] [lindex $tags 3]
  58.         }
  59.         message "[lindex $tags 4] selected."
  60.     } else {
  61.         beep
  62.         message "Cannot decide on enclosing tags."
  63.     }
  64. }
  65.   
  66. #===============================================================================
  67. # ◊◊◊◊ Select opening/Remove opening ◊◊◊◊ #
  68. #===============================================================================
  69.  
  70. # Select an opening tag, or remove it, of an element without a closing tag.
  71. proc html::RemoveOpening {} {html::SelectTag 1}
  72.  
  73. proc html::SelectTag {{remove 0}} {
  74.     set begin [getPos]
  75.     # back up one if possible and selection is wanted.
  76.     if {[pos::compare $begin > [minPos]] && !$remove} {set begin [pos::math $begin - 1]}
  77.     set tag [html::GetOpening $begin [expr !$remove]]
  78.     if {[llength $tag] == 3} {
  79.         if {$remove} {
  80.             set diff [pos::diff [lindex $tag 1] $begin]
  81.             deleteText [lindex $tag 0] [lindex $tag 1]
  82.             if {$diff > 0} {
  83.                 goto [pos::math [getPos] + $diff]
  84.             }
  85.             message "[lindex $tag 2] deleted."
  86.         } else {
  87.             select [lindex $tag 0] [lindex $tag 1]
  88.             message "[lindex $tag 2] selected."
  89.         }
  90.     } else {
  91.         if {$remove} {
  92.             beep
  93.             message "Cannot find opening tag."
  94.         } else {
  95.             beep
  96.             message "Cannot find opening tag."
  97.         }
  98.     }
  99. }
  100.  
  101. #===============================================================================
  102. # ◊◊◊◊ Untag/Untag and select ◊◊◊◊ #
  103. #===============================================================================
  104.  
  105. # remove containing tags
  106. proc html::UntagandSelect {} {html::Untag 1}
  107.  
  108. proc html::Untag {{selectit 0}} {
  109.     set curPos [getPos]
  110.     set tags [html::GetContainer $curPos [selEnd]]
  111.     if {[llength $tags] < 5} {
  112.         alertnote "Cannot decide on enclosing tags."
  113.         return
  114.     }
  115.     # delete them
  116.     replaceText [lindex $tags 0] [lindex $tags 3] \
  117.       [getText [lindex $tags 1] [lindex $tags 2]]
  118.     if {$selectit} {
  119.         select [lindex $tags 0] \
  120.           [pos::math [lindex $tags 2] - [pos::diff [lindex $tags 1] [lindex $tags 0]]]
  121.     } else {
  122.         if {[pos::compare $curPos < [lindex $tags 1]]} {set curPos [lindex $tags 1]}
  123.         if {[pos::compare $curPos > [lindex $tags 2]]} {set curPos [lindex $tags 2]}
  124.         goto [pos::math $curPos - [pos::diff [lindex $tags 1] [lindex $tags 0]]]
  125.     }
  126.     message "[lindex $tags 4] deleted."
  127. }
  128.  
  129. #===============================================================================
  130. # ◊◊◊◊ Change container/opening ◊◊◊◊ #
  131. #===============================================================================
  132.  
  133. # Change attributes of a tag.
  134. proc html::EditTag {{option 0}} {
  135.     set pos [getPos]
  136.     if {!$option && [doubleLookAt $pos] == "</" && [pos::compare $pos > [minPos]]} {set pos [pos::math $pos - 1]}
  137.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] || ($option == 2 &&
  138.     [pos::compare [lindex $res 1] < $pos])} {return}
  139.     set txt [getText [pos::math [lindex $res 0] + 1] [pos::math [lindex $res 1] - 1]]
  140.     if {[string index [set tag [lindex $txt 0]] 0] == "/" || $tag == "!--"} {return}
  141.     if {$option == 2} {set option 0}
  142.     if {[set newTag [html::ChangeElement $txt [string toupper $tag] [lindex $res 0] $option]] != ""} {
  143.         elec::ReplaceText [lindex $res 0] [lindex $res 1] $newTag
  144.     }
  145. }
  146.  
  147. #
  148. # Extracts all attributes to a element from a list, and puts up a dialog window
  149. # where the user can change the attributes.
  150. #
  151. proc html::ChangeElement {tag elem {wrPos 0} {maySkipDialog 0}} {
  152.     global HTMLmodeVars html::ElemAttrOptional html::Plugins html::HideDeprecated html::HideExtensions html::HideFrames
  153.     global html::NotInStrict html::NotInTransitional html::HTMLextensions html::DeprecatedElems
  154.     
  155.     set errText ""
  156.     html::ExtractAttrValues $tag attrs attrVals errText
  157.     
  158.     # All INPUT elements are defined differently. Must extract TYPE.
  159.     if {$elem == "INPUT"} {
  160.         set typeIndex [lsearch -exact [string toupper $attrs] "TYPE="]
  161.         if {$typeIndex >= 0 } {
  162.             set elem [string toupper [lindex $attrVals $typeIndex]]
  163.             set elem "INPUT TYPE=${elem}"
  164.             # Remove TYPE attribute from list.
  165.             set attrs [lreplace $attrs $typeIndex $typeIndex]
  166.             set attrVals [lreplace $attrVals $typeIndex $typeIndex]
  167.         } else {
  168.             set elem "INPUT TYPE=TEXT"
  169.         } 
  170.     }
  171.     
  172.     set used $elem
  173.     
  174.     # Element known by HTML mode?
  175.     if {![info exists html::ElemAttrOptional($elem)]} {
  176.         alertnote "$elem is unknown."
  177.         return
  178.     }
  179.     
  180.     if {(${html::HideExtensions} || ${html::HideDeprecated} || $HTMLmodeVars(hideDeprecated) || $HTMLmodeVars(hideExtensions)) 
  181.     && [lcontains html::HTMLextensions $elem]} {
  182.         alertnote "$elem is an extension to HTML. Either you have requested not to use extensions or the DTD excludes them."
  183.         return
  184.     }
  185.     if {(${html::HideFrames} && [lcontains html::NotInTransitional $elem]) ||
  186.     (${html::HideDeprecated} && [lcontains html::NotInStrict $elem])} {
  187.         alertnote "The DTD of the document excludes $elem."
  188.         return
  189.     }
  190.     if {$HTMLmodeVars(hideDeprecated) && [lcontains html::DeprecatedElems $elem]} {
  191.         alertnote "$elem is a deprecated element. You have requested not to use deprecated elements."
  192.         return
  193.     }
  194.     
  195.     # If EMBED element, choose which
  196.     if {$elem == "EMBED" && [llength ${html::Plugins}] > 1} {
  197.         if {[catch {listpick -p "Which plug-in?" [lsort ${html::Plugins}]} elem] || ![string length $elem]} {return}
  198.     }
  199.     
  200.     # If LI element, check in which list.
  201.     if {$elem == "LI"} {
  202.         html::FindList elem
  203.     }
  204.             
  205.     set useBig $HTMLmodeVars(changeInBigWindows)
  206.     set optatts [html::GetOptional $elem]
  207.     set alloptatts [html::GetOptional $elem 1]
  208.     set reqatts [html::GetRequired $elem]
  209.     set allAttrs [html::GetUsed $elem $reqatts $optatts]
  210.     set reallyAllAtts [string toupper [concat $reqatts $alloptatts]]
  211.     set extensions ""
  212.     set deprecated ""
  213.     set notinstrict ""
  214.         
  215.     if {${html::HideDeprecated} || $HTMLmodeVars(hideDeprecated)} {
  216.         set extensions [html::GetExtensions $elem]
  217.         set deprecated [html::GetDeprecated $elem]
  218.         set exp "\[ \n\r\t]+([join [concat $extensions $deprecated] |])"
  219.         regsub -all $exp " $allAttrs" " " allAttrs
  220.         regsub -all $exp " $reallyAllAtts" " " reallyAllAtts
  221.         if {${html::HideDeprecated}} {
  222.             set notinstrict "TARGET="
  223.             regsub "TARGET=" $allAttrs " " allAttrs
  224.             regsub "TARGET=" $reallyAllAtts " " reallyAllAtts
  225.         }
  226.     } elseif {${html::HideExtensions} || $HTMLmodeVars(hideExtensions)} {
  227.         set extensions [html::GetExtensions $elem]
  228.         set exp "\[ \n\r\t]+([join $extensions |])"
  229.         regsub -all $exp " $allAttrs" " " allAttrs
  230.         regsub -all $exp " $reallyAllAtts" " " reallyAllAtts
  231.     }
  232.  
  233.     # First check if one which is normally not used is used.
  234.     set addNotUsed 0
  235.     set toup [string toupper $allAttrs]
  236.     foreach a $attrs {
  237.         # Check for flags not in short form.
  238.         if {[lcontains reallyAllAtts [set tra [string trim $a =]]]} {
  239.             set attrs [lreplace $attrs [set ww [lsearch -exact $attrs $a]] $ww $tra]
  240.             set a $tra
  241.         }
  242.         if {![lcontains toup $a] && [lcontains reallyAllAtts $a]} {
  243.             regsub -all "\[ \n\r\t]+([join $allAttrs |])" " $optatts" " " notUsedAtts
  244.             append allAttrs " $notUsedAtts"
  245.             set addNotUsed 1
  246.             break
  247.         }
  248.     }
  249.     
  250.     # then check some hidden one is used
  251.     set addHidden 0
  252.     set toup [string toupper $allAttrs]
  253.     foreach a $attrs {
  254.         if {![lcontains toup $a] && [lcontains reallyAllAtts $a]} {
  255.             regsub -all "\[ \n\r\t]+([join $optatts |])" " $alloptatts" " " hiddenAtts
  256.             append allAttrs " $hiddenAtts"
  257.             set addNotUsed 1
  258.             set addHidden 1
  259.             break
  260.         }
  261.     }
  262.     # check if some is unknown, deprecated or extension
  263.     set toup [string toupper $allAttrs]
  264.     set extensions [string toupper $extensions]
  265.     set deprecated [string toupper $deprecated]
  266.     set notinstrict [string toupper $notinstrict]
  267.     foreach a $attrs {
  268.         if {[lcontains extensions $a]} {
  269.             lappend errText "[string trim $a =] is an extension to HTML."
  270.         } elseif {[lcontains deprecated $a]} {
  271.             lappend errText "[string trim $a =] is a deprecated attribute."
  272.         } elseif {[lcontains notinstrict $a]} {
  273.             lappend errText "[string trim $a =] may not be used with the strict DTD."
  274.         } elseif {![lcontains toup $a]} {
  275.             lappend errText "[string trim $a =] is an unknown attribute."
  276.         }
  277.     }
  278.     
  279.     
  280.     # Add something if all attrs are hidden.
  281.     if {![llength $allAttrs]} {
  282.         # Return if dialog not required.
  283.         if {$maySkipDialog} {return}
  284.         set allAttrs $optatts
  285.         set addNotUsed 1
  286.     } 
  287.     
  288.     # Does this element have any attributes?
  289.     if {![llength $allAttrs]} {
  290.         if {[llength $errText]} {
  291.             if {[askyesno "$elem has no attributes. Remove the ones in the text?"] == "no"} {
  292.                 return
  293.             } else {
  294.                 return [html::SetCase <$elem>]
  295.             }
  296.         } else {
  297.             beep
  298.             message "$elem has no attributes."
  299.             return
  300.         }
  301.     }
  302.     
  303.     set values ""
  304.     # Add two dummy elements for OK and Cancel buttons.
  305.     if {$useBig} {set values {0 0}}
  306.     # Build a list with attribute vales.
  307.     foreach a $allAttrs {
  308.         set attrIndex [lsearch -exact $attrs [string toupper $a]]
  309.         if {$attrIndex >= 0 } {
  310.             set aval [lindex $attrVals $attrIndex]
  311.         } else {
  312.             set aval ""
  313.         }
  314.         eval html::GetDialog[html::GetAttrType $elem $a] [list $elem] $a [list $aval] $useBig values errText
  315.     }
  316.     # If invalid attributes, continue?
  317.     if {[llength $errText] && ![html::ErrorWindow "$elem not well-defined" $errText 1]} {
  318.         return 
  319.     }
  320.     if {$useBig} {
  321.         set r [html::OpenElemWindow $used $elem [posX $wrPos] $values $addNotUsed $addHidden $wrPos]
  322.     } else {
  323.         set r [html::OpenElemStatusBar $used $elem [posX $wrPos] $values $addNotUsed $addHidden $wrPos]
  324.     }
  325.     return $r
  326. }
  327.  
  328. proc html::ExtractAttrValues {tag attr aval e {errtag ""}} {
  329.     upvar $attr attrs $aval attrVals $e err
  330.     # Remove tabs and returns from list.
  331.     regsub -all "\[\t\r\n\]+" $tag " " tag
  332.     
  333.     # Remove element name.
  334.     regsub { *[^ ]+} $tag "" tag
  335.     set tag [string trim $tag " >"]
  336.     set attrs ""
  337.     set attrVals ""
  338.     
  339.     # Extract the attributes.
  340.     set exp1 {([^ =]+)[ ]*=[ ]*"([^"]*)"}
  341.     set exp2 {([^ =]+)[ ]*=[ ]*'([^']*)'}
  342.     set exp3 {([^ =]+)[ ]*=[ ]*([^ "']+)}
  343.     foreach exp [list $exp1 $exp2 $exp3] {
  344.         while {[regexp -indices $exp $tag tag0 attr aval]} {
  345.             lappend attrs "[string toupper [eval string range [list $tag] $attr]]="
  346.             lappend attrVals [eval string range [list $tag] $aval]
  347.             set tag "[string range $tag 0 [expr {[lindex $tag0 0] - 1}]] [string range $tag [expr {[lindex $tag0 1] + 1}] end]"
  348.         }
  349.     }
  350.     if {[regsub -all {([^ =]+)[ ]*=[ ]*"[^"]*} $tag " " tag]} {
  351.         lappend err "Unmatched \"."
  352.     }
  353.     if {[regsub -all {([^ =]+)[ ]*=[ ]*'[^']*} $tag " " tag]} {
  354.         lappend err "Unmatched \'."
  355.     }
  356.     # Finally grab the flags
  357.     while {[regexp -indices {([^ =]+)} $tag "" attr]} {
  358.         lappend attrs [string toupper [eval string range [list $tag] $attr]]
  359.         lappend attrVals 1
  360.         set tag [string range $tag [expr {[lindex $attr 1] + 1}] end]
  361.     }
  362.     # Check for multiple attributes
  363.     regsub -all = $attrs "" attrs2
  364.     if {[llength $attrs2] != [llength [lunique $attrs2]]} {
  365.         foreach aa $attrs2 {
  366.             if {![info exists count($aa)]} {set count($aa) 1} else {
  367.                 incr count($aa)
  368.             }
  369.         }
  370.         foreach aa [array names count] {
  371.             if {$count($aa) > 1} {
  372.                 lappend err "Multiple $aa attributes$errtag."
  373.             }
  374.         }
  375.     }
  376. }
  377.  
  378. #===============================================================================
  379. # ◊◊◊◊ Get dialog ◊◊◊◊ #
  380. #===============================================================================
  381.  
  382. # flag 
  383. proc html::GetDialogflag {elem attr aval useBig v etext} {
  384.     upvar $v val $etext errText
  385.     if {$aval == "1" || [string toupper $aval] == "$attr"} {
  386.         lappend val 1
  387.     } else {
  388.         if {$aval != "" && [string toupper $aval] != "$attr"} {
  389.             lappend errText "$attr: Incorrect value, $aval"
  390.         }
  391.         lappend val 0
  392.     }
  393. }
  394.  
  395. # url 
  396. proc html::GetDialogurl {elem attr aval useBig v etext} {
  397.     upvar $v val
  398.     set aval [string trim $aval]
  399.     if {$aval != ""} {
  400.         set aval [html::URLunEscape $aval]
  401.         html::AddToCache URLs $aval
  402.         if {$useBig} {
  403.             lappend val "" $aval 0
  404.         } else {
  405.             lappend val $aval
  406.         }
  407.     } else {
  408.         if {$useBig} {
  409.             lappend val "" " " 0
  410.         } else {
  411.             lappend val ""
  412.         }
  413.     }
  414. }
  415.  
  416. # color 
  417. proc html::GetDialogcolor {elem attr aval useBig v etext} {
  418.     upvar $v val $etext errText
  419.     global html::userColorname html::ColorNumber
  420.     set aval [string trim $aval]
  421.     if {$aval != ""} {
  422.         set aval [html::CheckColorNumber $aval]
  423.         if {$aval == 0} {
  424.             lappend errText "$attr: Invalid color number."
  425.             if {$useBig} {
  426.                 lappend val "" " " 0
  427.             } else {
  428.                 lappend val ""
  429.             }
  430.         } elseif {[info exists html::userColorname($aval)]} {
  431.             if {$useBig} {
  432.                 lappend val "" [set html::userColorname($aval)] 0
  433.             } else {
  434.                 lappend val [set html::userColorname($aval)]
  435.             }
  436.         } elseif {[info exists html::ColorNumber($aval)]} {
  437.             if {$useBig} {
  438.                 lappend val "" [set html::ColorNumber($aval)] 0
  439.             } else {
  440.                 lappend val [set html::ColorNumber($aval)]
  441.             }
  442.         } else {
  443.             if {$useBig} {
  444.                 lappend val $aval " " 0
  445.             } else {
  446.                 lappend val $aval
  447.             }
  448.         }
  449.     } else {
  450.         if {$useBig} {
  451.             lappend val "" " " 0
  452.         } else {
  453.             lappend val ""
  454.         }
  455.     }
  456. }
  457.  
  458. # frametarget 
  459. proc html::GetDialogframetarget {elem attr aval useBig v etext} {
  460.     upvar $v val
  461.     set aval [string trim $aval]
  462.     if {$aval != ""} {
  463.         html::AddToCache windows $aval
  464.         if {$useBig} {
  465.             lappend val "" $aval
  466.         } else {
  467.             lappend val $aval
  468.         }
  469.     } else {
  470.         if {$useBig} {
  471.             lappend val "" " "
  472.         } else {
  473.             lappend val ""
  474.         }
  475.     }
  476. }
  477.  
  478. # choices 
  479. proc html::GetDialogchoices {elem attr aval useBig v etext} {
  480.     upvar $v val $etext errText
  481.     set aval [string trim $aval]
  482.     if {$aval != ""} {
  483.         set aval [string toupper $aval]
  484.         if {[set match [lsearch -exact [set choices [html::GetAttrChoices $elem $attr]] $aval]] >= 0} {
  485.             lappend val [lindex $choices $match]
  486.         } else {
  487.             lappend errText "$attr: Unknown choice, $aval."
  488.             lappend val ""
  489.         }
  490.     } else {
  491.         lappend val ""
  492.     }    
  493. }
  494.  
  495. # length 
  496. proc html::GetDialoglength {elem attr aval useBig v etext {multilength 0}} {
  497.     upvar $v val $etext errText
  498.     set aval [string trim $aval]
  499.     if {$aval != ""} {
  500.         set numcheck [html::CheckAttrNumber $elem $attr $aval 1 $multilength]
  501.         if {$numcheck == 1} {
  502.             lappend val $aval
  503.         } else {
  504.             lappend errText "$attr: $numcheck"
  505.             lappend val ""
  506.         }
  507.     } else {
  508.         lappend val ""
  509.     }
  510. }
  511.  
  512. # integer 
  513. proc html::GetDialoginteger {elem attr aval useBig v etext} {
  514.     upvar $v val $etext errText
  515.     set aval [string trim $aval]
  516.     if {$aval != ""} {
  517.         set numcheck [html::CheckAttrNumber $elem $attr $aval 0]
  518.         if {$numcheck == 1} {
  519.             lappend val $aval
  520.         } else {
  521.             lappend errText "$attr: $numcheck"
  522.             lappend val ""
  523.         }
  524.     } else {
  525.         lappend val ""
  526.     }
  527. }
  528.  
  529. # other 
  530. proc html::GetDialogother {elem attr aval useBig v etext} {
  531.     upvar $v val
  532.     lappend val [string trim $aval]
  533. }
  534.  
  535. # othernotrim
  536. proc html::GetDialogothernotrim {elem attr aval useBig v etext} {
  537.     upvar $v val
  538.     lappend val $aval
  539. }
  540.  
  541. # id
  542. proc html::GetDialogid {elem attr aval useBig v etext} {
  543.     upvar $v val $etext errText
  544.     set aval [string trim $aval]
  545.     if {$aval != ""} {
  546.         if {[html::CheckId $aval]} {
  547.             lappend val $aval
  548.         } else {
  549.             lappend errText "$attr: Must be first a letter and then letters, digits, and '_' '-' ':' '.'"
  550.             lappend val ""
  551.         }
  552.     } else {
  553.         lappend val ""
  554.     }
  555.     
  556. }
  557.  
  558. # ids
  559. proc html::GetDialogids {elem attr aval useBig v etext} {
  560.     upvar $v val $etext errText
  561.     set aval [string trim $aval]
  562.     if {$aval != ""} {
  563.         if {[html::CheckIds $aval]} {
  564.             lappend val $aval
  565.         } else {
  566.             lappend errText "$attr: Must be first a letter and then letters, digits, and '_' '-' ':' '.'"
  567.             lappend val ""
  568.         }
  569.     } else {
  570.         lappend val ""
  571.     }
  572.     
  573. }
  574.  
  575. # anchor
  576. proc html::GetDialoganchor {elem attr aval useBig v etext} {
  577.     upvar $v val $etext errText
  578.     if {[set aval [string trim $aval]] != ""} {
  579.         html::AddToCache URLs "#$aval"
  580.     }
  581.     html::GetDialogother $elem $attr $aval $useBig val errText
  582. }
  583.  
  584. # targetname
  585. proc html::GetDialogtargetname {elem attr aval useBig v etext} {
  586.     upvar $v val $etext errText
  587.     html::AddToCache windows [string trim $aval]
  588.     html::GetDialogother $elem $attr $aval $useBig val errText
  589. }
  590.  
  591. # contenttype 
  592. proc html::GetDialogcontenttype {elem attr aval useBig v etext} {
  593.     upvar $v val
  594.     global HTMLmodeVars
  595.     set aval [string tolower [string trim $aval]]
  596.     if {$aval != ""} {
  597.         if {![lcontains HTMLmodeVars(contenttypes) $aval]} {
  598.             lappend HTMLmodeVars(contenttypes) $aval
  599.             prefs::modifiedModeVar contenttypes HTML
  600.         }
  601.         if {$useBig} {
  602.             lappend val "" $aval
  603.         } else {
  604.             lappend val $aval
  605.         }
  606.     } else {
  607.         if {$useBig} {
  608.             lappend val "" " "
  609.         } else {
  610.             lappend val ""
  611.         }
  612.     }
  613. }
  614.  
  615. # contenttypes
  616. proc html::GetDialogcontenttypes {elem attr aval useBig v etext {types contenttypes} {comma 1}} {
  617.     upvar $v val
  618.     global HTMLmodeVars
  619.     set aval [string trim $aval]
  620.     if {$aval != ""} {
  621.         if {$comma} {
  622.             set alist [split $aval ,]
  623.         } else {
  624.             set alist $aval
  625.         }
  626.         foreach a $alist {
  627.             set a [string tolower [string trim $a]]
  628.             if {![lcontains HTMLmodeVars($types) $a]} {
  629.                 lappend HTMLmodeVars($types) $a
  630.                 prefs::modifiedModeVar $types HTML
  631.             }
  632.         }
  633.         if {$useBig} {
  634.             lappend val " " $aval 0
  635.         } else {
  636.             lappend val $aval
  637.         }
  638.     } else {
  639.         if {$useBig} {
  640.             lappend val " " "" 0
  641.         } else {
  642.             lappend val ""
  643.         }
  644.     }
  645. }
  646.  
  647. # eventhandler 
  648. proc html::GetDialogeventhandler {elem attr aval useBig v etext} {
  649.     upvar $v val $etext errText
  650.     html::GetDialogother $elem $attr $aval $useBig val errText
  651.     # to be modified
  652. }
  653.  
  654. # linktypes 
  655. proc html::GetDialoglinktypes {elem attr aval useBig v etext} {
  656.     upvar $v val $etext errText
  657.     html::GetDialogcontenttypes $elem $attr $aval $useBig val errText linktypes 0
  658. }
  659.  
  660. # multilength 
  661. proc html::GetDialogmultilength {elem attr aval useBig v etext} {
  662.     upvar $v val $etext errText
  663.     html::GetDialoglength $elem $attr $aval $useBig val errText 1
  664. }
  665.  
  666. # multilengths 
  667. proc html::GetDialogmultilengths {elem attr aval useBig v etext} {
  668.     upvar $v val $etext errText
  669.     html::GetDialogcoords $elem $attr $aval $useBig val errText 1
  670. }
  671.  
  672. # languagecode 
  673. proc html::GetDialoglanguagecode {elem attr aval useBig v etext} {
  674.     upvar $v val $etext errText
  675.     html::GetDialogother $elem $attr $aval $useBig val errText
  676.     # to be modified
  677. }
  678.  
  679. # charset 
  680. proc html::GetDialogcharset {elem attr aval useBig v etext} {
  681.     upvar $v val $etext errText
  682.     html::GetDialogother $elem $attr $aval $useBig val errText
  683.     # to be modified
  684. }
  685.  
  686. # charsets 
  687. proc html::GetDialogcharsets {elem attr aval useBig v etext} {
  688.     upvar $v val $etext errText
  689.     html::GetDialogother $elem $attr $aval $useBig val errText
  690.     # to be modified
  691. }
  692.  
  693. # coords 
  694. proc html::GetDialogcoords {elem attr aval useBig v etext {multilength 0}} {
  695.     upvar $v val $etext errText
  696.     set aval [string trim $aval]
  697.     if {$aval != ""} {
  698.         set av ""
  699.         set err 0
  700.         foreach l [split $aval ,] {
  701.             set l [string trim $l]
  702.             set numcheck [html::CheckAttrNumber $elem $attr $l 1 $multilength]
  703.             if {$numcheck == 1} {
  704.                 append av ",$l"
  705.             } else {
  706.                 lappend errText "$attr: $numcheck"
  707.                 set err 1
  708.                 lappend val ""
  709.                 break
  710.             }
  711.         }
  712.         if {!$err} {lappend val [string trim $av ,]}
  713.     } else {
  714.         lappend val ""
  715.     }
  716. }
  717.  
  718. # oltype 
  719. proc html::GetDialogoltype {elem attr aval useBig v etext} {
  720.     upvar $v val $etext errText
  721.     set aval [string trim $aval]
  722.     if {$aval != ""} {
  723.         if {[set match [lsearch -exact [set choices [html::GetAttrChoices $elem $attr]] $aval]] >= 0} {
  724.             lappend val [lindex $choices $match]
  725.         } else {
  726.             lappend errText "$attr: Unknown choice, $aval."
  727.             lappend val ""
  728.         }
  729.     } else {
  730.         lappend val ""
  731.     }    
  732. }
  733.  
  734. # datetime 
  735. proc html::GetDialogdatetime {elem attr aval useBig v etext} {
  736.     upvar $v val $etext errText
  737.     set aval [string trim $aval]
  738.     if {$aval != ""} {
  739.         if {[regexp {^([0-9]+)-([0-9]+)-([0-9]+)T([0-9]+):([0-9]+):([0-9]+)(Z|[-+][0-9]+:[0-9]+)$} $aval "" Y M D h m s tzd]} {
  740.             if {![catch {html::CheckDateTime [list $Y $M $D $h $m $s $tzd]} res]} {
  741.                 if {$useBig} {
  742.                     lappend val $Y $M $D $h $m $s $tzd 0
  743.                 } else {
  744.                     lappend val $aval
  745.                 }
  746.             } else {
  747.                 lappend errText "$attr: $res"
  748.                 if {$useBig} {
  749.                     lappend val "" "" "" "" "" "" "" 0
  750.                 } else {
  751.                     lappend val ""
  752.                 }
  753.             }
  754.         } else {
  755.             lappend errText "$attr: Incorrect date and time."
  756.             if {$useBig} {
  757.                 lappend val "" "" "" "" "" "" "" 0
  758.             } else {
  759.                 lappend val ""
  760.             }
  761.         }
  762.     }            
  763. }
  764.  
  765. # character 
  766. proc html::GetDialogcharacter {elem attr aval useBig v etext} {
  767.     upvar $v val $etext errText
  768.     set aval [string trim $aval]
  769.     if {$aval != ""} {
  770.         if {[string length $aval] == 1} {
  771.             lappend val $aval
  772.         } else {
  773.             lappend errText "$attr: Only a single character is allowed."
  774.             lappend val ""
  775.         }
  776.     } else {
  777.         lappend val ""
  778.     }
  779. }
  780.  
  781. # mediadesc 
  782. proc html::GetDialogmediadesc {elem attr aval useBig v etext} {
  783.     upvar $v val $etext errText
  784.     html::GetDialogcontenttypes $elem $attr $aval $useBig val errText mediatypes
  785. }
  786.  
  787.  
  788. #===============================================================================
  789. # ◊◊◊◊ Editing help procs ◊◊◊◊ #
  790. #===============================================================================
  791.  
  792. #
  793. # return positions of tags of including elements, as a list of 5 elements --
  794. # openstart openend closestart closeend elementname.
  795. # Elements without a closing tag are ignored.
  796. # args: point to start search backward from; point which must be enclosed
  797. #
  798. # if any problem, return just {0}
  799. #
  800. proc html::GetContainer {curPos inclPos} {
  801.  
  802.     set startPos $curPos
  803.     set startPos2 $inclPos
  804.     set searchFinished 0
  805.     message "Searching for enclosing tags…"
  806.     while {!$searchFinished} {
  807.         # find first tag
  808.         set isStartTag 0
  809.         while {!$isStartTag} {
  810.             if {[catch {html::FindFirstOccurance {<[^<>]+>} $startPos 0} res]} {
  811.                 message ""
  812.                 return {0}
  813.             }
  814.             set tag1start [lindex $res 0]
  815.             set tag1end   [lindex $res 1]
  816.             # get element name
  817.             if {![regexp {<([^ \t\r\n>]+)} [getText $tag1start $tag1end] tmp tag]} {
  818.                 message ""
  819.                 return {0}
  820.             }
  821.             # is this a closing tag?
  822.             if {[string index $tag 0] != "/"} {set isStartTag 1}
  823.             set startPos [pos::math $tag1start - 1]
  824.         }
  825.         # find closing tag
  826.         set res [html::GetClosing $tag $tag1end]
  827.         
  828.         set tag2start [lindex $res 0]
  829.         set tag2end   [lindex $res 1]
  830.         # If container enclosed along with us, or there is no closing tag,
  831.         # continue searching.
  832.         if {![llength $res] || [pos::compare $tag2end < $inclPos]} {
  833.             set startPos [pos::math $tag1start - 1]
  834.         } else {
  835.             set Container "$tag1start $tag1end $tag2start $tag2end" 
  836.             set searchFinished 1
  837.         }
  838.     }
  839.     
  840.     message ""
  841.     return [concat $Container [string toupper $tag]]
  842. }
  843.  
  844. #
  845. # return position an opening tag if the first element to the left
  846. # of startPos is an element with only an opening tag, as a list of 3 elements --
  847. # openstart openend elementname.
  848. #
  849. # if any problem, return empty string
  850. #
  851.  
  852. proc html::GetOpening {startPos {anyok 0}} {
  853.     
  854.     while {1} {
  855.         if {[catch {html::FindFirstOccurance {<[^<>]+>} $startPos 0} res]} {
  856.             return
  857.         }
  858.         set tag1start [lindex $res 0]
  859.         set tag1end   [lindex $res 1]
  860.         # get element name
  861.         if {![regexp {<([^ \t\r\n>]+)} [getText $tag1start $tag1end] tmp tag]} {
  862.             return
  863.         }
  864.         # is this a closing tag?
  865.         if {!$anyok && [string index $tag 0] == "/"} {return}
  866.         # comment?
  867.         if {[string range $tag 0 2] != "!--"} {break}
  868.         set startPos [pos::math $tag1start - 1]
  869.     }
  870.     
  871.     # find closing tag
  872.     set res ""
  873.     if {!$anyok} {set res [html::GetClosing $tag $tag1end]}
  874.     
  875.     if {![llength $res] } {
  876.         return "$tag1start $tag1end [string toupper $tag]"
  877.     } else {
  878.         return
  879.     }
  880.     
  881. }
  882.  
  883. proc html::GetClosing {tag sPos} {
  884.     set x </${tag}>
  885.     set sPos2 $sPos
  886.     while {1} {
  887.         if {[catch {html::FindFirstOccurance $x $sPos} res]} {return} 
  888.         # Look for another opening tag of the same element.
  889.         # Is it further away than the closing tag?
  890.         if {[catch {html::FindFirstOccurance "<${tag}(\[ \t\r\n\]+|>)" $sPos2} res2] || 
  891.         [pos::compare [lindex $res2 0] > [lindex $res 0]]} {break}
  892.         # If not, find the next closing tag.
  893.         set sPos [lindex $res 1]
  894.         set sPos2 [lindex $res2 1]
  895.     }
  896.     return $res
  897. }
  898.  
  899. # Determines which list the current position is inside.
  900. proc html::FindList {t {pos ""}} {
  901.     upvar $t tag
  902.     if {$pos == ""} {set pos [getPos]}
  903.     set listType ""
  904.     foreach l [list UL OL DIR MENU] {
  905.         set pos1 $pos; set pos2 $pos
  906.         # Search until a single list opening is found.
  907.         while {![catch {html::FindFirstOccurance "<${l}(\[ \t\r\n\]+\[^>\]*>|>)" $pos1 0} listOpening] && 
  908.         ![catch {html::FindFirstOccurance </$l> $pos2 0} listClosing] &&
  909.         [pos::compare [lindex $listClosing 0] > [lindex $listOpening 0]]} {
  910.             set pos1 [pos::math [lindex $listOpening 0] - 1]]
  911.             set pos2 [pos::math [lindex $listClosing 0] - 1]]
  912.         }
  913.         if {![catch {html::FindFirstOccurance "<${l}(\[ \t\r\n\]+\[^>\]*>|>)" $pos1 0} listOpening]} {
  914.             lappend listType "$listOpening $l"
  915.         }
  916.         
  917.     }
  918.     set ltype [lindex [lindex $listType 0] 2]
  919.     set lnum [lindex [lindex $listType 0] 0]
  920.     for {set i 1} {$i < [llength $listType]} {incr i} {
  921.         if {[pos::compare [lindex [lindex $listType $i] 0] > $lnum]} {
  922.             set ltype [lindex [lindex $listType $i] 2]
  923.             set lnum [lindex [lindex $listType $i] 0]
  924.         }
  925.     }
  926.     if {$ltype == "UL"} {
  927.         set tag "LI IN UL"
  928.     } elseif {$ltype == "OL"} {
  929.         set tag "LI IN OL"
  930.     }            
  931. }
  932.  
  933. #===============================================================================
  934. # ◊◊◊◊ Change choice ◊◊◊◊ #
  935. #===============================================================================
  936.  
  937. # Change choice of an attribute with pre-defined choices.
  938. proc html::ChangeChoice {} {
  939.     set pos [pos::math [getPos] - 1]
  940.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  941.     [pos::compare [lindex $res 1] < $pos] || 
  942.     ![regexp {<([^ \t\r\n>]+)} [eval getText $res] "" tag] ||
  943.     [catch {search -s -f 0 -r 1 -i 0 -m 0 {[^-a-zA-Z0-9][^= \t\r\n]+[ \t\r\n]*=[ \t\r\n]*(\"|\')?[^\"\' \t\n\r>]*(\"|\')?} $pos} res1] ||
  944.     [pos::compare [lindex $res1 1] < $pos] ||
  945.     ![regexp {([^=]+)=([ \t\r\n]*)((\"[^\" \t\r\n]*\")|(\'[^\' \t\r\n]*\')|([^ \t\r\n>]*))} \
  946.       [getText [pos::math [lindex $res1 0] + 1] [lindex $res1 1]] "" attr sp choice]} {
  947.         beep
  948.         message "Current position is not at an attribute with choices."
  949.         return
  950.     }
  951.     set pos0 [pos::math [lindex $res1 0] + [string length $attr] + [string length $sp] + 2]
  952.     set pos1 [pos::math $pos0 + [string length $choice]]
  953.     set choice [string trim $choice "\"'"]
  954.     set tag [string toupper $tag]
  955.     if {$tag == "INPUT"} {
  956.         if {![regexp -nocase {[^-a-zA-Z0-9]TYPE[ \t\r\n]*=[ \t\r\n]*('|\")?([^ \t\r\"'<>]+)(\"|')?} [eval getText $res] "" "" tag]} {
  957.             set tag TEXT
  958.         }
  959.         set tag "INPUT=[string toupper $tag]"
  960.     }
  961.     if {$tag == "LI"} {
  962.         html::FindList tag
  963.     }
  964.     set attr "[string trim [string toupper $attr]]="
  965.     if {[lsearch -exact [html::GetExcludedElems] $tag] >=0 || ([html::GetAttrType $tag $attr] != "choices" &&
  966.     [html::GetAttrType $tag $attr] != "oltype")} {
  967.         beep
  968.         message "Current position is not at an attribute with choices."
  969.         return
  970.     }
  971.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set choice [string toupper $choice]}
  972.     set choices [html::GetAttrChoices $tag $attr]
  973.     if {[set this [lsearch -exact $choices $choice]] < 0} {set this 0}
  974.     incr this
  975.     if {$this == [llength $choices]} {set this 0}
  976.     set this [lindex $choices $this]
  977.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set this [html::SetCase $this]}
  978.     replaceText $pos0 $pos1 "\"$this\""
  979.     if {[pos::compare [pos::math $pos0 + [string length $this]] > $pos]} {
  980.         goto [pos::math $pos + 1]
  981.     } else {
  982.         goto [pos::math $pos0 + [string length $this] + 1]
  983.     }
  984. }
  985.  
  986. #===============================================================================
  987. # ◊◊◊◊ Reveal color ◊◊◊◊ #
  988. #===============================================================================
  989.  
  990. # Convert colour names to numbers and vice versa.
  991. # Or brings up a color picker if cmd-doubleClick.
  992. proc html::RevealColor {{dblClick 0}} {
  993.     global html::ColorName html::ColorNumber html::userColors 
  994.     global html::userColorname
  995.  
  996.     set exp "("
  997.     foreach s [html::GetColorAttrs] {
  998.         append exp "[string trimright ${s} =]|"
  999.     } 
  1000.     # remove last |
  1001.     set exp [string trimright $exp |]
  1002.     append exp {)[ \t\r\n]*=[ \t\r\n]*(\"([^\"]*)\"|\'([^\']*)\'|([^ \t\r\n\"\'>]*))}
  1003.     set startpos [getPos]
  1004.     set endpos [selEnd]
  1005.     set cantfind 0
  1006.     # find attribute
  1007.     set f0 [search -s -f 0 -r 1 -i 1 -n -m 0 "<\[^!\]\[^<>\]*\[ \\t\\n\\r\]+$exp" $startpos]
  1008.     set f [search -s -f 0 -r 1 -i 1 -n -m 0 $exp $startpos]
  1009.     if {$f0 == "" || [pos::compare [lindex $f0 1] < $endpos] || $f == "" || [pos::compare [lindex $f 1] < $endpos]} {
  1010.         set cantfind 1
  1011.     }
  1012.     if {!$cantfind} {
  1013.         set txt [eval getText $f]
  1014.         regexp -indices -nocase $exp $txt a b c
  1015.         set cpos [pos::math [lindex $f 0] + [lindex $c 0]]
  1016.         set epos [pos::math [lindex $f 0] + [lindex $c 1] + 1]
  1017.         set col [string trim [string range $txt [lindex $c 0] [lindex $c 1]] "\"'"]
  1018.         if {!$dblClick} {
  1019.             if {[info exists html::ColorName($col)]} {
  1020.                 replaceText $cpos $epos "\"[set html::ColorName($col)]\""
  1021.             } elseif {[info exists html::ColorNumber($col)]} {
  1022.                 replaceText $cpos $epos "\"[set html::ColorNumber($col)]\""
  1023.             } elseif {[info exists html::userColorname($col)]} {
  1024.                 replaceText $cpos $epos "\"[set html::userColorname($col)]\""
  1025.             } elseif {[info exists html::userColors($col)]} {
  1026.                 replaceText $cpos $epos "\"[set html::userColors($col)]\""
  1027.             } else {
  1028.                 beep
  1029.                 message "Don't recognize color."
  1030.             }
  1031.         } else {
  1032.             if {[set ncol [html::CheckColorNumber $col]] != "0"} {
  1033.                 set ncol [html::HexColor $ncol]
  1034.             } else {
  1035.                 set ncol {65535 65535 65535}
  1036.             }
  1037.             set newcolor [html::AddANewColor $ncol]
  1038.             if {[string length $newcolor]} {
  1039.                 set newcolor [html::CheckColorNumber $newcolor]
  1040.                 replaceText $cpos $epos "\"$newcolor\""
  1041.             }
  1042.             return 1
  1043.         }
  1044.     } elseif {!$dblClick} {
  1045.         beep
  1046.         message "Current position is not at a color attribute."
  1047.     } else {
  1048.         return 0
  1049.     }
  1050. }
  1051.  
  1052. #===============================================================================
  1053. # ◊◊◊◊ Insert attributes ◊◊◊◊ #
  1054. #===============================================================================
  1055.  
  1056. # Inserts an attribute in a tag at the current position.
  1057. proc html::InsertAttributes {{attrList ""}} {
  1058.     global HTMLmodeVars fillColumn elecStopMarker
  1059.     set useMarks $HTMLmodeVars(useTabMarks)
  1060.     if {$attrList == "" && ([set l [html::GetAttributes]] == "" ||
  1061.     [catch {listpick -p "Select attributes" -l $l} attrList] || $attrList == "") } {return}
  1062.     foreach attr $attrList {
  1063.         set epos [pos::math [lindex [search -s -f 0 -r 1 -m 0 {<[^<>]+>} [getPos]] 1] - 1]
  1064.         if {[posX $epos] + [string length $attr] > $fillColumn && $HTMLmodeVars(wordWrap)} {
  1065.             set text "\r"
  1066.         } else {
  1067.             set text " "
  1068.         }
  1069.         append text $attr
  1070.         if {[string match "*=" $attr]} {
  1071.             append text "\""
  1072.             if {$useMarks} {append text "••"}        
  1073.             append text "\""
  1074.             if {$useMarks} {append text "••"}        
  1075.         }
  1076.         if {[doubleLookAt [pos::math [getPos] - 1]] == "\"\""} {
  1077.             set rpos [getPos]
  1078.             if {$useMarks} {
  1079.                 if {[string match "*=" $attr]} {
  1080.                     set text "[string range $text 0 [expr {[string length $text] - 6}]]••••\"••"
  1081.                 } else {
  1082.                     append text "••"
  1083.                 }
  1084.             }
  1085.             if {[lookAt [pos::math $epos - 1]] == $elecStopMarker} {
  1086.                 elec::ReplaceText [pos::math $epos - 1] $epos $text
  1087.             } else {
  1088.                 goto $epos
  1089.                 elec::Insertion $text
  1090.             }                
  1091.             goto $rpos
  1092.         } else {
  1093.             goto $epos
  1094.             elec::Insertion $text
  1095.         }
  1096.     }
  1097. }
  1098.  
  1099. # Returns a list of the attributes not used for the tag at the current position.
  1100. proc html::GetAttributes {} {
  1101.     set pos [getPos]
  1102.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^<>]+>} $pos} res] || [pos::compare [lindex $res 1] < $pos]} {
  1103.         message "Current position is not at a tag."
  1104.         return
  1105.     }
  1106.     regexp {<([^ \t\r\n>]*)} [string trim [set all [string toupper [eval getText $res]]]] "" tag
  1107.     if {$tag == "LI"} {
  1108.         html::FindList tag
  1109.     }
  1110.     # All INPUT elements are defined differently. Must extract TYPE.
  1111.     if {$tag == "INPUT"} {
  1112.         if {![regexp -nocase {[^-a-zA-Z0-9]TYPE[ \t\r\n]*=[ \t\r\n]*('|\")?([^ \t\r\"'<>]+)(\"|')?} $all "" "" tag]} {
  1113.             set tag TEXT
  1114.         }
  1115.         set tag [string toupper "INPUT TYPE=$tag"]
  1116.     }
  1117.     if {[lsearch -exact [html::GetExcludedElems] $tag] >=0} {message "No attributes."; return}
  1118.     set ret ""
  1119.     foreach a [concat [html::GetRequired $tag] [html::GetOptional $tag]] {
  1120.         set exp "\[^-a-zA-Z0-9\]${a}"
  1121.         if {[regexp = $a]} {regsub = $exp {[ \t\r\n]*=} exp}
  1122.         if {![regexp -nocase $exp $all]} {
  1123.             lappend ret $a
  1124.         }
  1125.     }
  1126.     if {$ret == ""} {message "No attributes."}
  1127.     return $ret
  1128. }
  1129.  
  1130. #===============================================================================
  1131. # ◊◊◊◊ Quote attributes, Tags to Lowercase/Uppercase ◊◊◊◊ #
  1132. #===============================================================================
  1133.  
  1134. # Put quotes around all attributes
  1135. proc html::QuoteAllAttributes {} {
  1136.     html::ScanAllTags quote
  1137. }
  1138.  
  1139. proc html::TagstoLowercase {} {
  1140.     html::ScanAllTags case tolower
  1141. }
  1142.  
  1143. proc html::TagstoUppercase {} {
  1144.     html::ScanAllTags case toupper
  1145. }
  1146.  
  1147. proc html::ScanAllTags {doWhat {upperLower ""}} {
  1148.     set pos [getPos]
  1149.     if {[isSelection]} {
  1150.         set start [getPos]
  1151.         set end [selEnd]
  1152.     } else {
  1153.         set start [minPos]
  1154.         set end [maxPos]
  1155.     }
  1156.     set text [getText $start $end]
  1157.     while {[regexp -indices {<!--|<[^<>]+>} $text tag]} {
  1158.         append newtext [string range $text 0 [lindex $tag 0]]
  1159.         set this [string range $text [expr {[lindex $tag 0] + 1}] [lindex $tag 1]]
  1160.         set text [string range $text [expr {[lindex $tag 1] + 1}] end]
  1161.         if {$this == "!--"} {
  1162.             if {[regexp -indices -- {-->} $text commend]} {
  1163.                 append newtext $this[string range $text 0 [lindex $commend 1]]
  1164.                 set text [string range $text [expr {[lindex $commend 1] + 1}] end]
  1165.             } else {
  1166.                 append newtext $text
  1167.                 set text ""
  1168.             }
  1169.         } else {
  1170.             if {$doWhat == "quote"} {
  1171.                 regsub -all "(\[ \t\r\n\]+\[^=\]+=)(\[ \t\r\n\]*)(\[^ >\"\t\r\n\]+)" $this {\1\2"\3"} newtag
  1172.             } else {
  1173.                 regsub -all {[][\$"\{\}]} $this {\\&} this
  1174.                 regsub "\[ \t\r\n\]*\[^ \t\r\n>]+" $this "\[string $upperLower \"&\"\]" newtag
  1175.                 set newtag [subst $newtag]
  1176.                 regsub -all {[][\$"\{\}]} $newtag {\\&} newtag
  1177.                 regsub -all "\[^-a-zA-Z0-9\]\[^ \t\r\n=\]+\[ \t\r\n\]*=" $newtag "\[string $upperLower \"&\"\]" newtag
  1178.                 set newtag [subst $newtag]
  1179.             }
  1180.             append newtext $newtag
  1181.         }
  1182.     }
  1183.     append newtext $text
  1184.     replaceText $start $end $newtext
  1185.     goto $pos
  1186. }
  1187.  
  1188. #===============================================================================
  1189. # ◊◊◊◊ Remove tags ◊◊◊◊ #
  1190. #===============================================================================
  1191.  
  1192. # Removes all tags in a selection or the whole document.
  1193. proc html::RemoveTags {} {
  1194.     if {![isSelection]} {
  1195.         if {[set ync [askyesno -c "Put text without tags in a new window?"]] == "cancel"} {return}
  1196.         set txt [html::TagStrip [getText [minPos] [maxPos]]]
  1197.         if {$ync == "yes"} {
  1198.             new
  1199.             insertText $txt
  1200.         } else {
  1201.             replaceText [minPos] [maxPos] $txt
  1202.         }
  1203.     } else {
  1204.         replaceText [getPos] [selEnd] [html::TagStrip [getSelect]]
  1205.     }
  1206. }
  1207.  
  1208. # Removes all tags from a string.
  1209. proc html::TagStrip {str} {
  1210.     regsub -all {<[^<>]*>} $str "" str
  1211.     return $str
  1212. }
  1213.